home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0016_Activate COM Port Off-On.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  4.6 KB  |  160 lines
  1. {BFCOM (C) 1995 Brian Leiter, All Rights Reserved}
  2. {12-07-95}  {No Error Checking}
  3.  
  4. Program BFCOM;
  5.  
  6. Uses CRT,Cursor2;
  7.  
  8. Var CH        : Char;
  9.     L,I       : Integer;
  10.     Param,Num : String;
  11.  
  12. Const Version='v1.2';
  13.  
  14. Procedure Error;
  15. Begin
  16.   Textcolor(7);Textbackground(0);
  17.   Clrscr;
  18.   Writeln('BFCOM ',Version,' (C) 1995 Brian Leiter, All Rights Reserved');
  19.   Writeln('');
  20.   Writeln('Usage:   BFCOM [Comport] [ON or OFF]');
  21.   Writeln('');
  22.   Writeln('Example: BFCOM 2 OFF     <-- Takes modem off-hook');
  23.   Writeln('         BFCOM 2 ON      <-- Puts modem on-hook');
  24.   Writeln('');
  25.   Writeln('         BFCOM 2 OFF /S  <-- Silent Mode, No BELLS');
  26.   CursorSmall;
  27.   Halt(0);
  28.   Exit;
  29. End;
  30.  
  31. Function Dial(NB:String; ComPort:Byte):Char;
  32. Const  DialCmd = 'AT';
  33.        OnHook  = 'ATH';
  34.        CR      =  #13;
  35.        Status  =  5;
  36. Var    UserKey : Char;
  37.        PortAdr : Word;
  38.  
  39. Procedure Com_Write(S: String);
  40. Var I : Byte;
  41.  
  42. Function OutputOk : Boolean;
  43. Begin
  44.   OutPutOk:=(Port[PortAdr+Status] and $20) > 0;
  45. End;
  46.  
  47. Procedure ComWriteCh(Var CH: Char);
  48. Begin
  49.   Repeat Until OutPutOk;
  50.   Port[PortAdr]:=Byte(CH);
  51. End;
  52.  
  53. Begin
  54.   For I:=1 To Length(S) Do ComWriteCh(S[I]);
  55. End;
  56.  
  57. Procedure Com_Writeln(S: String);
  58. Begin
  59.   Com_Write(S+CR)
  60. End;
  61.  
  62. {DIAL}
  63. Begin
  64.   If (ComPort<1) or (ComPort>4) Then Error;
  65.   PortAdr:=MemW[$40:(ComPort-1)*2];
  66.   If PortAdr=0 Then Error;
  67.   Com_Writeln(OnHook);
  68.   Delay(500);
  69.   Com_Write(DialCmd);
  70.   Com_Writeln(NB);
  71. End;
  72.  
  73. Begin {THE PROGRAM}
  74.   ClrScr;
  75.   CursorOff;
  76.   If (ParamStr(1)>'4') or (ParamStr(1)<'1') Then Error;
  77.   Param:=Paramstr(2);
  78.   L:=Length(Param);
  79.   For I:=1 To L Do Param[I]:=Upcase(Param[I]);
  80.   If Param='OFF' Then
  81.   Begin
  82.     Num:='H1M0';
  83.     Clrscr;
  84.     Gotoxy(20,8);
  85.     Textcolor(9);Textbackground(1);Write('█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█');
  86.     Textcolor(1);Textbackground(0);Writeln('▄');
  87.     Gotoxy(20,9);
  88.     Textcolor(9);Textbackground(1);Write('█ ');
  89.     Textcolor(14);Textbackground(0);Write(' BFCOM - (C) 1995 Brian Leiter ');
  90.     Textcolor(9);Textbackground(0);Write('█');
  91.     Textcolor(1);Textbackground(0);Writeln('█ ');
  92.     Gotoxy(20,10);
  93.     Textcolor(9);Textbackground(0);Write('█');
  94.     Textcolor(1);Textbackground(0);Write('█ ');
  95.     Textcolor(9);Textbackground(0);Write('                              █');
  96.     Textcolor(1);Textbackground(0);Writeln('█ ');
  97.     Gotoxy(20,11);
  98.     Textcolor(9);Textbackground(0);Write('█');
  99.     Textcolor(1);Textbackground(0);Write('█ ');
  100.     Textcolor(15);Textbackground(0);Write('Taking Modem Off-Hook:        ');
  101.     Textcolor(9);Textbackground(0);Write('█');
  102.     Textcolor(1);Textbackground(0);Writeln('█');
  103.     Gotoxy(20,12);
  104.     Textcolor(9);Textbackground(0);Write('▀');
  105.     Textcolor(9);Textbackground(1);Write('▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀');
  106.     Textcolor(1);Textbackground(0);Writeln('█');
  107.   End;
  108.   If Param='ON' Then
  109.   Begin
  110.     Num:='H0M1';
  111.     Clrscr;
  112.     Gotoxy(20,8);
  113.     Textcolor(9);Textbackground(1);Write('█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█');
  114.     Textcolor(1);Textbackground(0);Writeln('▄');
  115.     Gotoxy(20,9);
  116.     Textcolor(9);Textbackground(1);Write('█ ');
  117.     Textcolor(14);Textbackground(0);Write(' BFCOM - (C) 1995 Brian Leiter ');
  118.     Textcolor(9);Textbackground(0);Write('█');
  119.     Textcolor(1);Textbackground(0);Writeln('█ ');
  120.     Gotoxy(20,10);
  121.     Textcolor(9);Textbackground(0);Write('█');
  122.     Textcolor(1);Textbackground(0);Write('█ ');
  123.     Textcolor(9);Textbackground(0);Write('                              █');
  124.     Textcolor(1);Textbackground(0);Writeln('█ ');
  125.     Gotoxy(20,11);
  126.     Textcolor(9);Textbackground(0);Write('█');
  127.     Textcolor(1);Textbackground(0);Write('█ ');
  128.     Textcolor(15);Textbackground(0);Write('Putting Modem On-Hook:        ');
  129.     Textcolor(9);Textbackground(0);Write('█');
  130.     Textcolor(1);Textbackground(0);Writeln('█');
  131.     Gotoxy(20,12);
  132.     Textcolor(9);Textbackground(0);Write('▀');
  133.     Textcolor(9);Textbackground(1);Write('▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀');
  134.     Textcolor(1);Textbackground(0);Writeln('█');
  135.   End;
  136.   {ACTUAL PROGRAM}
  137.   If ParamStr(1)='1' Then CH:=Dial(Num,1);
  138.   If ParamStr(1)='2' Then CH:=Dial(Num,2);
  139.   If ParamStr(1)='3' Then CH:=Dial(Num,3);
  140.   If ParamStr(1)='4' Then CH:=Dial(Num,4);
  141.   Delay(2000);
  142.   If (ParamStr(3)<>'/S') and (ParamStr(3)<>'/s') Then
  143.   Begin
  144.     Sound(900);Delay(150);
  145.     Sound(700);Delay(50);
  146.     Sound(900);Delay(150);
  147.     Sound(700);Delay(50);
  148.     Sound(900);Delay(150);
  149.     Sound(700);Delay(50);
  150.     NoSound;
  151.   End;
  152.   If Param='OFF' Then Textcolor(12);
  153.   If Param='ON' Then Textcolor(10);
  154.   Gotoxy(48,11);
  155.   Writeln('DONE');
  156.   Delay(1500);
  157.   CursorSmall;
  158.   Clrscr;
  159. End.
  160.